Developer CD Series 1995…tember: Reference Library/Dev.CD Sep 95 RL/Dev.CD Sep 95 RL.toast/mac/Technical Documentation/develop/develop Issue 23 code/Internet Config/IC 1.1/ICProgKit1.1/Source/Internet Config Source/ICRAPI.p

Text File | 1995-04-23 | 39.9 KB | 1,333 lines | [TEXT/PJMM]

unit ICRAPI;

interface

    uses
{$ifc undefined THINK_Pascal}
        Types, Files, QuickDraw, Aliases,
{$endc}
        Components, ICTypes, ICKeys;

    type
        ICRRecord = record                    (* this is *completely* private to the implementation!!! *)
                instance: ComponentInstance;        (* nil if no component available, if not nil then rest of record is junk *)
                have_config_file: boolean;
                config_file: FSSpec;
                config_refnum: integer;
                perm: ICPerm;
                inside_begin: boolean;
                default_filename: Str63;
            end;
        ICRRecordPtr = ^ICRRecord;

    function ICRStart (var inst: ICRRecord; creator: OSType): ICError;
    function ICRStop (var inst: ICRRecord): ICError;

    function ICRFindConfigFile (var inst: ICRRecord; count: integer; folders: ICDirSpecArrayPtr): ICError;
    function ICRFindUserConfigFile (var inst: ICRRecord; where: ICDirSpec): ICError;
    function ICRSpecifyConfigFile (var inst: ICRRecord; config: FSSpec): ICError;

    function ICRGetSeed (var inst: ICRRecord; var seed: longint): ICError;
    function ICRGetPerm (var inst: ICRRecord; var perm: ICPerm): ICError;

    function ICRBegin (var inst: ICRRecord; perm: ICPerm): ICError;
    function ICRGetPref (var inst: ICRRecord; key: Str255; var attr: ICAttr; buf: Ptr; var size: longint): ICError;
    function ICRSetPref (var inst: ICRRecord; key: Str255; attr: ICAttr; buf: Ptr; size: longint): ICError;
    function ICRGetPrefHandle (var inst: ICRRecord; key: Str255; var attr: ICAttr; var prefh: Handle): ICError;
    function ICRSetPrefHandle (var inst: ICRRecord; key: Str255; attr: ICAttr; prefh: Handle): ICError;
    function ICRCountPref (var inst: ICRRecord; var count: longint): ICError;
    function ICRGetIndPref (var inst: ICRRecord; n: longint; var key: Str255): ICError;
    function ICRDeletePref (var inst: ICRRecord; key: Str255): ICError;
    function ICREnd (var inst: ICRRecord): ICError;
    function ICRDefaultFileName (var inst: ICRRecord; var name: Str63): ICError;

    function ICREditPreferences (var inst: ICRRecord; key: Str255): ICError;

    function ICRParseURL (var inst: ICRRecord; hint: Str255; data: Ptr; len: longint; var selStart, selEnd: longint; url: Handle): ICError;
    function ICRLaunchURL (var inst: ICRRecord; hint: Str255; data: Ptr; len: longint; var selStart, selEnd: longint): ICError;

    function ICRMapFilename (var inst: ICRRecord; filename: Str255; var entry: ICMapEntry): ICError;
    function ICRMapTypeCreator (var inst: ICRRecord; fType, fCreator: OSType; filename: Str255; var entry: ICMapEntry): ICError;

    function ICRCountMapEntries (var inst: ICRRecord; entries: Handle; var count: longint): ICError;
    function ICRGetIndMapEntry (var inst: ICRRecord; entries: Handle; ndx: longint; var pos: longint; var entry: ICMapEntry): ICError;
    function ICRGetMapEntry (var inst: ICRRecord; entries: Handle; pos: longInt; var entry: ICMapEntry): ICError;
    function ICRSetMapEntry (var inst: ICRRecord; entries: Handle; pos: longInt; var entry: ICMapEntry): ICError;
    function ICRDeleteMapEntry (var inst: ICRRecord; entries: Handle; pos: longint): ICError;
    function ICRAddMapEntry (var inst: ICRRecord; entries: Handle; var entry: ICMapEntry): ICError;

(* These are exported solely for the component implementation. *)
    function ICRMapEntriesFilename (var inst: ICRRecord; entries: Handle; filename: Str255; var entry: ICMapEntry): ICError;
    function ICRMapEntriesTypeCreator (var inst: ICRRecord; entries: Handle; fType, fCreator: OSType; filename: Str255; var entry: ICMapEntry): ICError;

implementation

    uses
{$ifc undefined THINK_Pascal}
        Resources, GestaltEqu, OSUtils, Memory, Errors, ToolUtils, Packages,
{$endc}
        AppleTalk, Folders,

        ICRSubs;

    function ICFindFolder (vRefNum: integer; folderType: OSType; createFolder: boolean; var foundVRefNum: integer; var foundDirID: longint): OSErr;
    inline
        $7000, $A823;

    const
        Res_Code = 'ICRP';

    function ICRStart (var inst: ICRRecord; creator: OSType): ICError;
        var
            junk: ICError;
    begin
        inst.have_config_file := false;
        inst.config_file.vRefNum := 0;
        inst.config_file.parID := 0;
        inst.config_file.name := '';
        inst.config_refnum := 0;
        inst.perm := icNoPerm;
        junk := ICRDefaultFileName(inst, inst.default_filename);
        ICRStart := noErr;
    end; (* ICRStart *)

    procedure ICRCloseIfOpen (var inst: ICRRecord);
    begin
        if inst.config_refnum <> 0 then begin
            CloseResFile(inst.config_refnum);
            inst.config_refnum := 0;
        end; (* if *)
        inst.perm := icNoPerm;
    end; (* ICRCloseIfOpen *)

    function ICRStop (var inst: ICRRecord): ICError;
    begin
        ICRCloseIfOpen(inst);
        ICRStop := noErr;
    end; (* ICRStop *)

    function ValidDirSpec (folder: ICDirSpec): ICError;
        var
            cpb: CInfoPBRec;
    begin
        cpb.ioVRefNum := folder.vRefNum;
        cpb.ioDirID := folder.dirID;
        cpb.ioNamePtr := nil;
        cpb.ioFDirIndex := -1;
        ValidDirSpec := PBGetCatInfoSync(@cpb);
    end; (* ValidDirSpec *)

    function ScanFolder (var inst: ICRRecord; folder: ICDirSpec; var found_file: FSSpec): boolean;

        function FoundFile (folder: ICDirSpec; ndx: integer; var found_file: FSSpec): OSErr;
            var
                err: OSErr;
                cpb: CInfoPBRec;
                is_folder: boolean;
                was_alias: boolean;
                response: longint;
        begin
            with cpb do begin (* safe *)
                ioVRefNum := folder.vRefNum;
                ioDirID := folder.dirID;
                ioNamePtr := @found_file.name;
                ioFDirIndex := ndx;
                err := PBGetCatInfoSync(@cpb);
                if err = noErr then begin
                    found_file.vRefNum := cpb.ioVRefNum;
                    found_file.parID := cpb.ioFlParID;
                    if (btst(cpb.ioFlAttrib, 4) or (cpb.ioFlFndrInfo.fdType <> ICfiletype)) then begin
                        err := 1;
                    end
                    else if (Gestalt(gestaltAliasMgrAttr, response) = noErr) & btst(response, gestaltAliasMgrPresent) then begin
                        err := ResolveAliasFile(found_file, true, is_folder, was_alias);
                        if err <> noErr then begin
                            err := 1;
                        end; (* if *)
                    end; (* if *)
                end; (* if *)
            end; (* with *)
            FoundFile := err;
        end; (* FoundFile *)

        var
            err: ICError;
            found: boolean;
            i: integer;
    begin
        found_file.name := (inst.default_filename);
        found := (FoundFile(folder, 0, found_file) = noErr);
        if not found then begin
            i := 1;
            repeat
                found_file.name := '';
                err := FoundFile(folder, i, found_file);
                i := i + 1;
            until err <> 1;
            found := (err = noErr);
        end; (* if *)
        ScanFolder := found;
    end; (* ScanFolder *)

    function ICRFindConfigFile (var inst: ICRRecord; count: integer; folders: ICDirSpecArrayPtr): ICError;

        function FindPrefFolder (var pref_fold: ICDirSpec): OSErr;
            var
                err: OSErr;
                env: SysEnvRec;
                junk: longint;
                response: longint;
        begin
            if (Gestalt(gestaltFindFolderAttr, response) = noErr) & btst(response, gestaltFindFolderPresent) then begin
                (* Gestalt says it's implemented -- call it directly *)
                err := ICFindFolder(kOnSystemDisk, kPreferencesFolderType, true, pref_fold.vRefNum, pref_fold.dirID);
            end
            else begin
                (* Simulate the important stuff *)
                err := SysEnvirons(curSysEnvVers, env);
                if err = noErr then begin
                    err := GetWDInfo(env.sysVRefNum, pref_fold.vRefNum, pref_fold.dirID, junk);
                end; (* if *)
            end; (* if *)
            FindPrefFolder := err;
        end; (* FindPrefFolder *)

        var
            err: ICError;
            i: integer;
            found: boolean;
            pref_fold: ICDirSpec;
    begin
        ICRCloseIfOpen(inst);                { ! }
        err := noErr;
        if (count < 0) | ((count <> 0) & (folders = nil)) then begin
            err := paramErr;
        end; (* if *)
        i := 0;
        while (err = noErr) & (i < count) do begin
            err := ValidDirSpec(folders^[i]);
            i := i + 1;
        end; (* for *)
        if err = noErr then begin
            i := 0;
            found := false;
            while (i < count) and not found do begin
                found := ScanFolder(inst, folders^[i], inst.config_file);
                i := i + 1;
            end; (* while *)
            if not found then begin
                err := FindPrefFolder(pref_fold);
                if (err = noErr) & not ScanFolder(inst, pref_fold, inst.config_file) then begin
                    inst.config_file.vRefNum := pref_fold.vRefNum;
                    inst.config_file.parID := pref_fold.dirID;
                    inst.config_file.name := inst.default_filename;
                end; (* if *)
            end; (* if *)
        end; (* if *)
        inst.have_config_file := (err = noErr);
        ICRFindConfigFile := err;
    end; (* ICRFindConfigFile *)

    function ICRFindUserConfigFile (var inst: ICRRecord; where: ICDirSpec): ICError;
        var
            err: ICError;
            found: boolean;
    begin
        ICRCloseIfOpen(inst);                { ! }
        err := ValidDirSpec(where);
        if err = noErr then begin
            if not ScanFolder(inst, where, inst.config_file) then begin
                inst.config_file.vRefNum := where.vRefNum;
                inst.config_file.parID := where.dirID;
                inst.config_file.name := inst.default_filename;
            end; (* if *)
        end; (* if *)
        inst.have_config_file := (err = noErr);
        ICRFindUserConfigFile := err;
    end; (* ICRFindUserConfigFile *)

    function ICRSpecifyConfigFile (var inst: ICRRecord; config: FSSpec): ICError;
        var
            err: ICError;
            folder: ICDirSpec;
    begin
        ICRCloseIfOpen(inst);                { ! }
        folder.vRefNum := config.vRefNum;
        folder.dirID := config.parID;
        err := ValidDirSpec(folder);
        if err = noErr then begin
            inst.config_file := config;
        end; (* if *)
        inst.have_config_file := (err = noErr);
        ICRSpecifyConfigFile := err;
    end; (* ICRSpecifyConfigFile *)

    function ICRGetSeed (var inst: ICRRecord; var seed: longint): ICError;
        var
            err: ICError;
            cpb: CInfoPBRec;
    begin
        seed := 0;
        err := fnfErr;
        if inst.have_config_file then begin
            with cpb do begin (* safe *)
                ioVRefNum := inst.config_file.vRefNum;
                ioDirID := inst.config_file.parID;
                ioNamePtr := @inst.config_file.name;
                ioFDirIndex := 0;
            end; (* with *)
            err := PBGetCatInfoSync(@cpb);
            if err = noErr then begin
                seed := cpb.ioFlMdDat;
            end
            else if err = fnfErr then begin
                err := noErr;
            end; (* if *)
        end; (* if *)
        ICRGetSeed := err;
    end; (* ICRGetSeed *)

    function ICRGetPerm (var inst: ICRRecord; var perm: ICPerm): ICError;
    begin
        perm := inst.perm;
        ICRGetPerm := noErr;
    end; (* ICRGetPerm *)

    function ICRPermToFSPerm (perm: ICPerm): integer;
    begin
        case perm of
            icReadOnlyPerm:
                ICRPermToFSPerm := fsRdPerm;
            icReadWritePerm:
                ICRPermToFSPerm := fsRdWrPerm;
            otherwise
                ICRPermToFSPerm := 0;
        end; (* case *)
    end; (* ICRPermToFSPerm *)

    function ICRBegin (var inst: ICRRecord; perm: ICPerm): ICError;
        var
            err: ICError;
            ref: integer;
            junk: OSErr;
    begin
        err := noErr;
        if (inst.perm <> icNoPerm) or (perm = icNoPerm) then begin
            err := paramErr;
        end; (* if *)
        if err = noErr then begin
            ICRCloseIfOpen(inst);                { ! }
            if not inst.have_config_file then begin
                err := bdNamErr;
            end; (* if *)
        end; (* if *)
        if err = noErr then begin
            ref := HOpenResFile(inst.config_file.vRefNum, inst.config_file.parID, inst.config_file.name, ICRPermToFSPerm(perm));
            err := ResError;
            if (err = fnfErr) or (err = eofErr) then begin
                case perm of
                    icReadOnlyPerm:  begin
                        ref := 0;
                        err := noErr;
                    end; (* icReadOnlyPerm *)
                    icReadWritePerm:  begin
                        junk := HCreate(inst.config_file.vRefNum, inst.config_file.parID, inst.config_file.name, ICcreator, ICfiletype);
                        HCreateResFile(inst.config_file.vRefNum, inst.config_file.parID, inst.config_file.name);
                        ref := HOpenResFile(inst.config_file.vRefNum, inst.config_file.parID, inst.config_file.name, ICRPermToFSPerm(perm));
                        err := ResError;
                    end; (* icReadWritePerm *)
                end; (* case *)
            end; (* if *)
        end; (* if *)
        if err = noErr then begin
            inst.config_refnum := ref;
            inst.perm := perm;
        end; (* if *)
        case err of
            opWrErr, permErr:
                err := icNoMoreWritersErr;
            otherwise { do nothing }
        end; (* case *)
        ICRBegin := err;
    end; (* ICRBegin *)

    function ICRCheckInside (var inst: ICRRecord): ICError;
    begin
        if inst.perm = icNoPerm then begin
            ICRCheckInside := paramErr;
        end
        else begin
            ICRCheckInside := noErr;
        end; (* if *)
    end; (* ICRCheckInside *)

    function ICRForceInside (var inst: ICRRecord; perm: ICPerm; var force_info: boolean): ICError;
        var
            err: ICError;
    begin
        force_info := false;
        if (inst.perm = perm) or ((inst.perm = icReadWritePerm) and (perm = icReadOnlyPerm)) then begin
            err := noErr;
        end
        else if inst.perm = icNoPerm then begin
            err := ICRBegin(inst, perm);
            force_info := (err = noErr);
        end
        else begin
            err := icPermErr;
        end; (* if *)
        ICRForceInside := err;
    end; (* ICRForceInside *)

    function ICRReleaseInside (var inst: ICRRecord; force_info: boolean): ICError;
    begin
        if force_info then begin
            ICRReleaseInside := ICREnd(inst);
        end
        else begin
            ICRReleaseInside := noErr;
        end; (* if *)
    end; (* ICRReleaseInside *)

    function ICRGetPref (var inst: ICRRecord; key: Str255; var attr: ICAttr; buf: Ptr; var size: longint): ICError;
        var
            err: ICError;
            err2: ICError;
            max_size: longint;
            true_size: longint;
            old_refnum: integer;
            prefh: Handle;
            force_info: boolean;
    begin
        max_size := size;
        size := 0;
        attr := ICattr_no_change;
        prefh := nil;
        err := ICRForceInside(inst, icReadOnlyPerm, force_info);
        if (err = noErr) and (inst.config_refnum = 0) then begin
            err := icPrefNotFoundErr;
        end; (* if *)
        if (err = noErr) and ((key = '') or ((max_size < 0) and (buf <> nil))) then begin
            err := paramErr;
        end; (* if *)
        if err = noErr then begin
            old_refnum := CurResFile;
            UseResFile(inst.config_refnum);
            err := ResError;
            if err = noErr then begin
                prefh := Get1NamedResource(Res_Code, key);
                err := ResError;
                if prefh = nil then begin
                    err := icPrefNotFoundErr;
                end; (* if *)
                if err = noErr then begin
                    true_size := GetHandleSize(prefh);
                    if true_size < 4 then begin
                        err := icPrefDataErr;
                    end; (* if *)
                end; (* if *)
                if err = noErr then begin
                    size := true_size - 4;
                    attr := longintPtr(prefh^)^;
                    if (buf <> nil) and (size <> 0) then begin
                        if size > max_size then begin
                            err := icTruncatedErr;
                        end
                        else begin
                            max_size := size;
                        end; (* if *)
                        BlockMove(ptr(longint(prefh^) + 4), buf, max_size);
                    end; (* if *)
                end; (* if *)
                UseResFile(old_refnum);
            end; (* if *)
        end; (* if *)
        if prefh <> nil then begin
            ReleaseResource(prefh);
        end; (* if *)
        err2 := ICRReleaseInside(inst, force_info);
        if err = noErr then begin
            err := err2;
        end; (* if *)
        ICRGetPref := err;
    end; (* ICRGetPref *)

    function ICRSetPref (var inst: ICRRecord; key: Str255; attr: ICAttr; buf: Ptr; size: longint): ICError;
        var
            err: ICError;
            err2: ICError;
            old_attr: longint;
            old_refnum: integer;
            prefh: Handle;
            id: integer;
            force_info: boolean;
    begin
        prefh := nil;
        if buf = nil then begin
            size := 0;
        end;
        err := ICRForceInside(inst, icReadWritePerm, force_info);
        if (err = noErr) and (inst.perm <> icReadWritePerm) then begin
            err := icPermErr;
        end; (* if *)
        if (err = noErr) and (inst.config_refnum = 0) then begin
            err := icInternalErr;
        end; (* if *)
        if (err = noErr) and ((key = '') or (size < 0)) then begin
            err := paramErr;
        end; (* if *)
        if err = noErr then begin
            old_refnum := CurResFile;
            UseResFile(inst.config_refnum);
            err := ResError;
            if err = noErr then begin
                prefh := Get1NamedResource(Res_Code, key);
                if (prefh <> nil) & (GetHandleSize(prefh) < 4) then begin { very bad! }
                    RmveResource(prefh);
                    DisposeHandle(prefh);
                    prefh := nil;
                end;
                if (prefh = nil) then begin
                    old_attr := 0;
                end
                else begin
                    old_attr := longintPtr(prefh^)^;
                end;
                if attr = ICattr_no_change then begin
                    attr := old_attr;
                end; (* if *)
                if btst(old_attr, ICattr_locked_bit) and btst(attr, ICattr_locked_bit) and (buf <> nil) then begin
                    err := icPermErr;
                end; (* if *)
                if (prefh = nil) then begin
                    prefh := NewHandle(size + 4);
                    err := MemError;
                    if err = noErr then begin
                        repeat
                            id := Unique1ID(Res_Code);
                        until id > 127;
                        AddResource(prefh, Res_Code, id, key);
                        err := ResError;
                        if err <> noErr then begin
                            DisposeHandle(prefh);
                            prefh := nil;
                        end; (* if *)
                    end; (* if *)
                end; (* if *)
                if (err = noErr) & (buf <> nil) then begin
                    SetHandleSize(prefh, size + 4);
                    err := MemError;
                end; (* if *)
                if (err = noErr) & (size > 0) then begin
                    BlockMove(buf, ptr(longint(prefh^) + 4), size);
                end; (* if *)
                if (err = noErr) then begin
                    longintPtr(prefh^)^ := attr;
                    ChangedResource(prefh);
                    WriteResource(prefh);
                    err := ResError;
                end; (* if *)
                UseResFile(old_refnum);
            end; (* if *)
        end; (* if *)
        if prefh <> nil then begin
            ReleaseResource(prefh);
        end; (* if *)
        err2 := ICRReleaseInside(inst, force_info);
        if err = noErr then begin
            err := err2;
        end; (* if *)
        ICRSetPref := err;
    end; (* ICRSetPref *)

    (* I call ICRForceInside to speed this routine up.  ICRForceInside will do an ICRBegin and hence open the resource *)
    (* file, which is good because otherwise I'd open it twice, once for each ICRGetPref. *)

    function ICRGetPrefHandle (var inst: ICRRecord; key: Str255; var attr: ICAttr; var prefh: Handle): ICError;
        var
            err: ICError;
            prefsize: longint;
            force_info: boolean;
            err2: ICError;
    begin
        prefh := nil;
        prefsize := 0;
        err := ICRForceInside(inst, icReadOnlyPerm, force_info);
        if err = noErr then begin
            err := ICRGetPref(inst, key, attr, nil, prefsize);
        end; (* if *)
        if err <> noErr then begin
            prefsize := 0;
        end; (* if *)
        prefh := NewHandle(prefsize);
        err := MemError;
        if err = noErr then begin
            HLock(prefh);
            err := ICRGetPref(inst, key, attr, prefh^, prefsize);
            if err = icPrefNotFoundErr then begin
                attr := 0;
                err := noErr;
            end; (* if *)
            HUnlock(prefh);
        end; (* if *)
        if err <> noErr then begin
            if prefh <> nil then begin
                DisposeHandle(prefh);
            end; (* if *)
            prefh := nil;
        end; (* if *)
        err2 := ICRReleaseInside(inst, force_info);
        if err = noErr then begin
            err := err2;
        end; (* if *)
        ICRGetPrefHandle := err;
    end; (* ICRGetPrefHandle *)

    function ICRSetPrefHandle (var inst: ICRRecord; key: Str255; attr: ICAttr; prefh: Handle): ICError;
        var
            s: SignedByte;
            err: ICError;
    begin
        err := noErr;
        if prefh <> nil then begin
            if prefh^ = nil then begin
                err := paramErr;
            end; (* if *)
            if err = noErr then begin
                s := HGetState(prefh);
                HLock(prefh);
                err := ICRSetPref(inst, key, attr, prefh^, GetHandleSize(prefh));
                HSetState(prefh, s);
            end; (* if *)
        end else begin
            err := ICRSetPref(inst, key, attr, nil, 0);
        end; (* if *)
        ICRSetPrefHandle := err;
    end; (* ICRSetPrefHandle *)

    function ICRCountPref (var inst: ICRRecord; var count: longint): ICError;
        var
            err: ICError;
            old_refnum: integer;
    begin
        err := ICRCheckInside(inst);
        if err = noErr then begin
            if inst.config_refnum = 0 then begin
                count := 0;
            end
            else begin
                old_refnum := CurResFile;
                UseResFile(inst.config_refnum);
                err := ResError;
                if err = noErr then begin
                    count := Count1Resources(Res_Code);
                    err := ResError;
                    UseResFile(old_refnum);
                end; (* if *)
            end; (* if *)
        end; (* if *)
        if err <> noErr then begin
            count := 0;
        end; (* if *)
        ICRCountPref := err;
    end; (* ICRCountPref *)

    function ICRGetIndPref (var inst: ICRRecord; n: longint; var key: Str255): ICError;
        var
            err: ICError;
            old_refnum: integer;
            prefh: Handle;
            junk_id: integer;
            junk_type: ResType;
    begin
        prefh := nil;
        err := ICRCheckInside(inst);
        if (err = noErr) and (n < 1) then begin
            err := paramErr;
        end; (* if *)
        if err = noErr then begin
            if inst.config_refnum = 0 then begin
                err := icPrefNotFoundErr;
            end
            else begin
                old_refnum := CurResFile;
                UseResFile(inst.config_refnum);
                err := ResError;
                if err = noErr then begin
                    SetResLoad(false);
                    prefh := Get1IndResource(Res_Code, n);
                    SetResLoad(true);
                    if prefh = nil then begin
                        err := icPrefNotFoundErr;
                    end
                    else begin
                        GetResInfo(prefh, junk_id, junk_type, key);
                        err := ResError;
                    end; (* if *)
                    UseResFile(old_refnum);
                end; (* if *)
            end; (* if *)
        end; (* if *)
        if prefh <> nil then begin
            ReleaseResource(prefh);
        end; (* if *)
        ICRGetIndPref := err;
    end; (* ICRGetIndPref *)

    function ICRDeletePref (var inst: ICRRecord; key: Str255): ICError;
        var
            err: ICError;
            prefh: Handle;
            old_refnum: integer;
    begin
        err := ICRCheckInside(inst);
        if (err = noErr) and (key = '') then begin
            err := paramErr;
        end; (* if *)
        if err = noErr then begin
            if inst.config_refnum = 0 then begin
                err := icPrefNotFoundErr;
            end
            else begin
                old_refnum := CurResFile;
                UseResFile(inst.config_refnum);
                err := ResError;
                if err = noErr then begin
                    SetResLoad(false);
                    prefh := Get1NamedResource(Res_Code, key);
                    err := ResError;
                    SetResLoad(true);
                    if prefh = nil then begin
                        err := icPrefNotFoundErr;
                    end; (* if *)
                    if err = noErr then begin
                        RmveResource(prefh);
                        err := ResError;
                    end; (* if *)
                    UseResFile(old_refnum);
                end; (* if *)
            end; (* if *)
        end; (* if *)
        ICRDeletePref := err;
    end; (* ICRDeletePref *)

    function ICREnd (var inst: ICRRecord): ICError;
        var
            err: ICError;
    begin
        err := ICRCheckInside(inst);
        ICRCloseIfOpen(inst);
        ICREnd := err;
    end; (* ICREnd *)

    function ICRDefaultFileName (var inst: ICRRecord; var name: Str63): ICError;
    begin
        name := ICdefault_file_name;
        ICRDefaultFileName := noErr;
    end; (* ICRDefaultFileName *)

    function ICREditPreferences (var inst: ICRRecord; key: Str255): ICError;
        var
            err: ICError;
    begin
        err := noErr;
        if not inst.have_config_file then begin
            err := bdNamErr;
        end; (* if *)
        if err = noErr then begin
            err := EditPreferences(key, inst.config_file);
        end; (* if *)
        ICREditPreferences := err;
    end; (* ICREditPreferences *)

(* URL Parsing Algorithm *)

{1. if there is a selection skip to step 4}
{2. expand selection to end of word (never skip an angle bracket though) }
{3. if either end has an angle bracket then expand other end to search for angle bracket}
{4. strip trailing and leading whitespace}
{5. strip whitespace CR whitespace}
{6. off < > if necessary}
{7. remove leading URL:}
{8. extract protocol by looking forwards for :}
{9. if no protocol then prepend "hint:"}

    const
        verybig = 100000;
    type
        dataArray = packed array[0..verybig] of char;
        dataPtr = ^dataArray;
        dataHandle = ^dataPtr;

    function ExpandSelection (datap: dataPtr; len: longint; var selStart, selEnd: longint): ICError;
        var
            err: ICError;
            found: boolean;
    begin
        err := noErr;
        (* expand leading selection backwards looking for word break *)
        while (selStart > 0) & not (datap^[selStart - 1] in [' ', '<', chr(9), chr(13)]) do begin
            selStart := selStart - 1;
        end; (* while *)
        if (selStart > 0) & (datap^[selStart - 1] = '<') then begin
            selStart := selStart - 1;
        end; (* if *)
        (* expand trailing selection forwards looking for work break *)
        while (selEnd < len) & not (datap^[selEnd] in [' ', '>', chr(9), chr(13)]) do begin
            selEnd := selEnd + 1;
        end; (* while *)
        if (selEnd < len) & (datap^[selEnd] = '>') then begin
            selEnd := selEnd + 1;
        end; (* if *)
        (* if first character was a < then expand trailing selection to meet matching > *)
        if datap^[selStart] = '<' then begin
            found := false;
            while not found and (selEnd - 1 < len) do begin
                found := (datap^[selEnd - 1] = '>');
                if not found then begin
                    selEnd := selEnd + 1;
                end; (* if *)
            end; (* while *)
            if not found then begin
                err := icNoURLErr;
            end; (* if *)
        end; (* if *)
        (* if last character was a > then expand leading selection to meet matching < *)
        if (err = noErr) & (selEnd > 0) & (datap^[selEnd - 1] = '>') then begin
            found := (datap^[selStart] = '<');
            while not found and (selStart >= 0) do begin
                found := (datap^[selStart] = '<');
                if not found then begin
                    selStart := selStart - 1;
                end; (* if *)
            end; (* if *)
            if not found then begin
                err := icNoURLErr;
            end; (* if *)
        end; (* if *)
        ExpandSelection := err;
    end; (* ExpandSelection *)

    function ShrinkSelection (datap: dataPtr; len: longint; var selStart, selEnd: longint): ICError;
    begin
        (* strip leading whitespace *)
        while (selStart < len) & (datap^[selStart] in [' ', chr(9)]) do begin
            selStart := selStart + 1;
        end; (* while *)
        (* strip trailing whitespace *)
        while (selEnd > 0) & (datap^[selEnd - 1] in [' ', chr(9)]) do begin
            selEnd := selEnd - 1;
        end; (* while *)
        ShrinkSelection := noErr;
    end; (* ShrinkSelection *)

    function StripReturns (urlh: dataHandle): ICError;
            (* removes any sequence of <whitespace> <cr> <whitespace> from urlh *)
        var
            srcsize: longint;
            srcndx: longint;
            dstndx: longint;
            err: ICError;
    begin
        srcsize := GetHandleSize(Handle(urlh));
        srcndx := 0;
        dstndx := 0;
            (* skip down the handle copying src to dst except when meeting cr *)
        while srcndx < srcsize do begin
            if urlh^^[srcndx] = chr(13) then begin
                    (* move dstndx back to point to previous non-whitespace *)
                while (dstndx > 0) & (urlh^^[dstndx - 1] in [' ', chr(9)]) do begin
                    dstndx := dstndx - 1;
                end; (* while *)
                    (* move srcndx forwards to next non-whitespace *)
                while (srcndx < srcsize) & (urlh^^[srcndx] in [' ', chr(9), chr(13)]) do begin
                    srcndx := srcndx + 1;
                end; (* while *)
            end; (* case *)
            if srcndx < srcsize then begin
                    (* copy a byte from src to dst *)
                urlh^^[dstndx] := urlh^^[srcndx];
                srcndx := srcndx + 1;
                dstndx := dstndx + 1;
            end; (* if *)
        end; (* while *)
            (* resize the handle to the number of bytes that we copied *)
        SetHandleSize(Handle(urlh), dstndx);
        err := MemError;
        if (err = noErr) & (GetHandleSize(Handle(urlh)) = 0) then begin
            err := icNoURLErr;
        end; (* if *)
        StripReturns := err;
    end; (* StripReturns *)

    function ICRParseURL (var inst: ICRRecord; hint: Str255; data: Ptr; len: longint; var selStart, selEnd: longint; url: Handle): ICError;
        var
            datap: dataPtr;
            urlh: dataHandle;
            tmp: Str15;
            junklong: longint;
            ndx: longint;
            err: ICError;
    begin
        datap := dataPtr(data);
        urlh := dataHandle(url);
        err := noErr;
        if (data = nil) | (url = nil) | (url^ = nil) | (len <= 0) | (selStart < 0) | (selEnd < 0) | (selStart > len) | (selEnd > len) | (selStart > selEnd) then begin
            err := paramErr;
        end; (* if *)
        if (err = noErr) and (selStart = selEnd) then begin
            err := ExpandSelection(datap, len, selStart, selEnd);
        end; (* if *)
        if err = noErr then begin
            (* remove leading and trailing whitespace sequences *)
            err := ShrinkSelection(datap, len, selStart, selEnd);
        end; (* if *)
        if (err = noErr) and (selStart >= selEnd) then begin
            err := icNoURLErr;
        end; (* if *)
        if err = noErr then begin
            (* copy the selection out into url *)
            err := PtrToXHand(@datap^[selStart], url, selEnd - selStart);
        end; (* if *)
        if err = noErr then begin
            (* remove any <whitespace> <cr> <whitespace> sequences *)
            err := StripReturns(urlh);
        end; (* if *)
        if err = noErr then begin
            (* trip any enclosing < > *)
            if (urlh^^[0] = '<') and (urlh^^[GetHandleSize(Handle(urlh)) - 1] = '>') then begin
                SetHandleSize(Handle(urlh), GetHandleSize(Handle(urlh)) - 1);        (* trim off tail *)
                junklong := Munger(Handle(urlh), 0, nil, 1, Ptr(-1), 0);    (* trim off first character *)
            end; (* if *)
            (* trim off leading "URL:" *)
            tmp := 'URL:';
            HLock(Handle(urlh));
            if (GetHandleSize(Handle(urlh)) >= length(tmp)) & (IUMagString(Ptr(urlh^), @tmp[1], length(tmp), length(tmp)) = 0) then begin
                HUnlock(Handle(urlh));        (* unlock 'cause Munger is going to want it that way *)
                junklong := Munger(Handle(urlh), 0, nil, 4, Ptr(-1), 0);    (* trim off 'URL:' character *)
            end;
            HUnlock(Handle(urlh));
            (* search for protocol *)
            tmp := ':';
            ndx := Munger(Handle(urlh), 0, @tmp[1], length(tmp), nil, 0);
            if (ndx < 0) or (ndx > 255) then begin
                (* failed to find : in first 256 bytes, prepend "hint:" to URL *)
                if hint = '' then begin
                    err := icNoURLErr;
                end
                else begin
                    hint := concat(hint, ':');
                    junklong := Munger(Handle(urlh), 0, nil, 0, @hint[1], length(hint));
                    err := MemError;
                end; (* if *)
            end; (* if *)
        end; (* if *)
        ICRParseURL := err;
    end; (* ICRParseURL *)

    function ICRLaunchURL (var inst: ICRRecord; hint: Str255; data: Ptr; len: longint; var selStart, selEnd: longint): ICError;
        var
            err: ICError;
            urlh: Handle;
            helper: ICAppSpec;
            scheme: Str255;
            junk_attr: longint;
            size: longint;
    begin
        urlh := NewHandle(0);
        err := MemError;
        if err = noErr then begin
            err := ICRParseURL(inst, hint, data, len, selStart, selEnd, urlh);
        end; (* if *)
        if err = noErr then begin
            err := FindScheme(urlh, scheme);
        end; (* if *)
        if err = noErr then begin
            size := sizeof(helper);
            err := ICRGetPref(inst, concat(kICHelper, scheme), junk_attr, @helper, size);
        end; (* if *)
        if err = noErr then begin
            err := LaunchURL(helper.fCreator, urlh);
        end; (* if *)
        if urlh <> nil then begin
            DisposeHandle(urlh);
        end; (* if *)
        ICRLaunchURL := err;
    end; (* ICRLaunchURL *)

(* Internal Mapping Subs *)

    function UnpackEntry (entries: handle; pos: longInt; var entry: ICMapEntry; var user_length: longInt): OSErr;
(* WARNING: Depends very much on the exact format of ICMapEntry! *)
        procedure CopyString (var p: ptr; var s: str255);
            var
                len: integer;
        begin
            len := BAND(p^, $FF) + 1;
            BlockMove(p, @s, len);
            p := ptr(ord(p) + len);
        end;
        var
            org: Ptr;
            p: ptr;
            maxsize: longInt;
            err: OSErr;
    begin
        err := noErr;
        if (entries = nil) | (entries^ = nil) | (pos < 0) | (pos > GetHandleSize(entries) - 6) then begin
            err := paramErr;
        end;
        if err = noErr then begin
            p := (ptr(ord(entries^) + pos));
            maxsize := GetHandleSize(entries);
            org := p;
            BlockMove(p, @entry, 6);
            if (entry.fixed_length <> ICmap_fixed_length) | (entry.fixed_length > entry.total_length) | (entry.total_length > maxsize) then begin
                err := badExtResource;
            end;
        end;
        if err = noErr then begin
            BlockMove(p, @entry, entry.fixed_length);
            p := ptr(ord(p) + entry.fixed_length);
            CopyString(p, entry.extension);
            CopyString(p, entry.creator_app_name);
            CopyString(p, entry.post_app_name);
            CopyString(p, entry.MIME_type);
            CopyString(p, entry.entry_name);
            user_length := entry.total_length - (ord(p) - ord(org));
        end;
        UnpackEntry := err;
    end;

    function FastGetEntry (entries: Handle; pos: longint; var entry: ICMapEntry): OSErr;
(* A fast version of ICRGetEntry, doesn't return all of the strings in the entry. *)
(* WARNING: Depends very much on the exact format of ICMapEntry! *)
        var
            org: Ptr;
            p: ptr;
            maxsize: longInt;
            err: OSErr;
    begin
        err := noErr;
        if (entries = nil) | (entries^ = nil) | (pos < 0) | (pos > GetHandleSize(entries) - 6) then begin
            err := paramErr;
        end;
        if err = noErr then begin
            p := (ptr(ord(entries^) + pos));
            maxsize := GetHandleSize(entries);
            BlockMove(p, @entry, 6);
            if (entry.fixed_length <> ICmap_fixed_length) | (entry.fixed_length > entry.total_length) | (entry.total_length > maxsize) then begin
                err := badExtResource;
            end;
        end;
        if err = noErr then begin
            BlockMove(p, @entry, entry.fixed_length);
            p := ptr(ord(p) + entry.fixed_length);
            BlockMove(p, @entry.extension, band(p^, $00FF) + 1);
        end;
        FastGetEntry := err;
    end; (* FastGetEntry *)

    procedure PackEntry (var entry: ICMapEntry; p: ptr; user_length: longInt);
        procedure CopyString (var s: str255);
        begin
            BlockMove(@s, ptr(ord(p) + entry.total_length), length(s) + 1);
            entry.total_length := entry.total_length + length(s) + 1;
        end;
    begin
        entry.version := 0;
        entry.fixed_length := ord(@entry.extension) - ord(@entry);
        entry.total_length := entry.fixed_length;
        CopyString(entry.extension);
        CopyString(entry.creator_app_name);
        CopyString(entry.post_app_name);
        CopyString(entry.MIME_type);
        CopyString(entry.entry_name);
        entry.total_length := entry.total_length + user_length;
        BlockMove(@entry, p, entry.fixed_length);
    end;

    function GetShort (p: Ptr): integer;
    begin
        GetShort := BAND(p^, $FF) * 256 + BAND(ptr(ord(p) + 1)^, $FF);
    end;

    function UpCase (ch: char): char;
    inline
        $301F, $0C00, $0061, $6500, $000E, $0C00, $007B, $6400, $0006, $0400, $0020, $3E80;

    function IsExtensionVar (var name, ext: str255): boolean;
        var
            pn, pe: integer;
    begin
        IsExtensionVar := false;
        if length(name) >= length(ext) then begin
            pn := length(name) - length(ext) + 1;
            pe := 1;
            while pe <= length(ext) do begin
                if UpCase(name[pn]) <> UpCase(ext[pe]) then begin
                    leave;
                end; (* if *)
                pn := pn + 1;
                pe := pe + 1;
            end; (* while *)
            IsExtensionVar := (pe > length(ext));
        end; (* if *)
    end; (* IsExtensionVar *)

(* Low Level Mapping Routines *)

    function ICRCountMapEntries (var inst: ICRRecord; entries: Handle; var count: longint): ICError;
        var
            err: ICError;
            p: Ptr;
            pos: longint;
            size: integer;
    begin
        err := noErr;
        if (entries = nil) | (entries^ = nil) then begin
            err := paramErr;
        end; (* if *)
        if err = noErr then begin
            p := entries^;
            pos := 0;
            count := 0;
            while pos < GetHandleSize(entries) do begin
                size := GetShort(p);
                pos := pos + size;
                p := ptr(ord(p) + size);
                count := count + 1;
            end; (* while *)
        end; (* if *)
        ICRCountMapEntries := err;
    end; (* ICRCountMapEntries *)

    function ICRGetIndMapEntry (var inst: ICRRecord; entries: handle; ndx: longint; var pos: longint; var entry: ICMapEntry): ICError;
        var
            err: ICError;
            p: Ptr;
            i: longint;
            size: integer;
    begin
        err := noErr;
        if (entries = nil) | (entries^ = nil) | (ndx < 0) then begin
            err := paramErr;
        end; (* if *)
        if err = noErr then begin
            p := entries^;
            pos := 0;
            while (ndx > 1) & (pos < GetHandleSize(entries)) do begin
                size := GetShort(p);
                pos := pos + size;
                p := Ptr(ord(p) + size);
                ndx := ndx - 1;
            end; (* while *)
            err := ICRGetMapEntry(inst, entries, pos, entry);
        end; (* if *)
        ICRGetIndMapEntry := err;
    end; (* ICRGetIndMapEntry *)

    function ICRGetMapEntry (var inst: ICRRecord; entries: handle; pos: longInt; var entry: ICMapEntry): ICError;
        var
            err: ICError;
            user_length: longInt;
    begin
        err := noErr;
        if (entries = nil) | (entries^ = nil) | (pos < 0) | (pos >= GetHandleSize(entries)) then begin
            err := paramErr;
        end; (* if *)
        if err = noErr then begin
            err := UnpackEntry(entries, pos, entry, user_length);
        end; (* if *)
        ICRGetMapEntry := err;
    end; (* ICRGetMapEntry *)

    function ICRSetMapEntry (var inst: ICRRecord; entries: handle; pos: longInt; var entry: ICMapEntry): ICError;
        var
            err: ICError;
            e: ICMapEntry;
            oldentry: ICMapEntry;
            user_length: longInt;
            source_length: longInt;
            junk: longInt;
    begin
        err := noErr;
        if (entries = nil) | (entries^ = nil) | (pos < 0) | (pos >= GetHandleSize(entries)) then begin
            err := paramErr;
        end; (* if *)
        if err = noErr then begin
            err := UnpackEntry(entries, pos, oldentry, user_length);
        end; (* if *)
        if err = noErr then begin
            PackEntry(entry, @e, user_length);
            source_length := oldentry.total_length - user_length;
            if user_length < 8 then begin { hack to remove alignment bytes from previous version }
                source_length := oldentry.total_length;
                e.total_length := e.total_length - user_length;
                user_length := 0;
            end;
            junk := Munger(entries, pos, nil, source_length, @e, e.total_length - user_length);
            err := MemError;
        end;
        ICRSetMapEntry := err;
    end; (* ICRSetMapEntry *)

    function ICRDeleteMapEntry (var inst: ICRRecord; entries: handle; pos: longint): ICError;
        var
            err: ICError;
            entry: ICMapEntry;
            junk: longint;
            user_length: longInt;
    begin
        err := noErr;
        if (entries = nil) | (entries^ = nil) | (pos < 0) | (pos >= GetHandleSize(entries)) then begin
            err := paramErr;
        end; (* if *)
        if err = noErr then begin
            err := UnpackEntry(entries, pos, entry, user_length);
        end; (* if *)
        if err = noErr then begin
            junk := Munger(entries, pos, nil, entry.total_length, Ptr(-1), 0);
            err := MemError;
        end;
        ICRDeleteMapEntry := err;
    end; (* ICRDeleteMapEntry *)

    function ICRAddMapEntry (var inst: ICRRecord; entries: handle; var entry: ICMapEntry): ICError;
        var
            err: ICError;
            tmp_entry: ICMapEntry;
    begin
        err := noErr;
        if (entries = nil) | (entries^ = nil) then begin
            err := paramErr;
        end; (* if *)
        if err = noErr then begin
            PackEntry(entry, @tmp_entry, 0);
            err := PtrAndHand(@tmp_entry, entries, entry.total_length);
        end; (* if *)
        ICRAddMapEntry := err;
    end; (* ICRAddMapEntry *)

(* High Level Mapping Subs *)

    function ICRMapEntriesFilename (var inst: ICRRecord; entries: Handle; filename: Str255; var entry: ICMapEntry): ICError;
        (* implementation lifted directly from Space Aliens *)
        var
            err: ICError;
            longest_len: integer;
            posndx: longint;
            found_pos: longint;
    begin
        err := noErr;
        if (entries = nil) | (entries^ = nil) | (filename = '') then begin
            err := paramErr;
        end; (* if *)
        if err = noErr then begin
            (* loop through the entries *)
            (* looking for the longest match *)
            longest_len := 0;
            posndx := 0;
            while FastGetEntry(entries, posndx, entry) = noErr do begin
                (* the entry matches if *)
                (* not_incoming flag bit is clear *)
                (* it's longer than the previous max *)
                (* it's longer than the file name *)
                (* it matches the last N chars of the filename *)
                if (length(entry.extension) > longest_len) & not btst(entry.flags, ICmap_not_incoming_bit) & IsExtensionVar(filename, entry.extension) then begin
                    (* record the new longest entry *)
                    found_pos := posndx;
                    longest_len := length(entry.extension);
                end; (* if *)
                (* increment posndx so that we get the next *)
                (* entry the next time around the loop *)
                posndx := posndx + entry.total_length;
            end; (* while *)
        end; (* if *)
        if (err = noErr) & (longest_len = 0) then begin
            err := icPrefNotFoundErr;
        end; (* if *)
        if (err = noErr) then begin
            err := ICRGetMapEntry(inst, entries, found_pos, entry);
        end; (* if *)
        ICRMapEntriesFilename := err;
    end; (* ICRMapEntriesFilename *)

    function ICRMapEntriesTypeCreator (var inst: ICRRecord; entries: Handle; fType, fCreator: OSType; filename: Str255; var entry: ICMapEntry): ICError;
        var
            err: ICError;
            posndx: longint;
            found_pos: longint;
            match_weight: longint;
            best_weight: longint;
    begin
        err := noErr;
        if (entries = nil) | (entries^ = nil) then begin
            err := paramErr;
        end; (* if *)
        if err = noErr then begin
            posndx := 0;
            best_weight := -1;
            while FastGetEntry(entries, posndx, entry) = noErr do begin
                if not btst(entry.flags, ICmap_not_outgoing_bit) then begin
                    if entry.file_type = fType then begin
                        match_weight := ord(entry.file_creator = fCreator);
                        if IsExtensionVar(filename, entry.extension) then begin
                            match_weight := match_weight + 2 * length(entry.extension);
                        end; (* if *)
                        if match_weight > best_weight then begin
                            (* record the new longest entry *)
                            found_pos := posndx;
                            best_weight := match_weight;
                        end; (* if *)
                    end; (* if *)
                end; (* if *)
                posndx := posndx + entry.total_length;
            end; (* while *)
            if best_weight = -1 then begin
                err := icPrefNotFoundErr;
            end
            else begin
                err := ICRGetMapEntry(inst, entries, found_pos, entry);
            end; (* if *)
        end; (* if *)
        ICRMapEntriesTypeCreator := err;
    end; (* ICRMapEntriesTypeCreator *)

(* High Level Mapping Routines *)

    function ICRMapFilename (var inst: ICRRecord; filename: Str255; var entry: ICMapEntry): ICError;
        var
            err: ICError;
            entries: Handle;
            junk_attr: ICAttr;
    begin
        err := noErr;
        if filename = '' then begin
            err := paramErr;
        end; (* if *)
        if err = noErr then begin
            err := ICRGetPrefHandle(inst, kICMapping, junk_attr, entries);
        end; (* if *)
        if err = noErr then begin
            err := ICRMapEntriesFilename(inst, entries, filename, entry);
            DisposeHandle(entries);
        end; (* if *)
        ICRMapFilename := err;
    end; (* ICRMapFilename *)

    function ICRMapTypeCreator (var inst: ICRRecord; fType, fCreator: OSType; filename: Str255; var entry: ICMapEntry): ICError;
        var
            err: ICError;
            entries: Handle;
            junk_attr: ICAttr;
    begin
        err := ICRGetPrefHandle(inst, kICMapping, junk_attr, entries);
        if err = noErr then begin
            err := ICRMapEntriesTypeCreator(inst, entries, fType, fCreator, filename, entry);
            DisposeHandle(entries);
        end; (* if *)
        ICRMapTypeCreator := err;
    end; (* ICRMapTypeCreator *)

end. (* ICRAPI *)